home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 001-100 / 001-025 / 003 / xlisp / xlisp.h < prev    next >
C/C++ Source or Header  |  1995-03-17  |  7KB  |  282 lines
  1. /* xlisp - a small subset of lisp */
  2.  
  3. /* system specific definitions */
  4. #define UNIX
  5.  
  6. #ifdef AZTEC
  7. #include "stdio.h"
  8. #include "setjmp.h"
  9. #else
  10. #include <stdio.h>
  11. #ifdef AMIGA
  12. struct JMP_BUF {        /* Early versions of Lattice C for the */
  13.     long jmpret;        /* AMIGA did not have <setjmp.h>, but */
  14.     long jmp_d1;        /* did have the corresponding library */
  15.     long jmp_d2;        /* functions.  This declaration is */
  16.     long jmp_d3;        /* compatible with the library functions. */
  17.     long jmp_d4;
  18.     long jmp_d5;
  19.     long jmp_d6;
  20.     long jmp_d7;
  21.     long jmp_a1;
  22.     long jmp_a2;
  23.     long jmp_a3;
  24.     long jmp_a4;
  25.     long jmp_a5;
  26.     long jmp_a6;
  27.     long jmp_a7;
  28. };
  29. typedef JMP_BUF jmp_buf[1];
  30. #else
  31. #include <setjmp.h>
  32. #include <ctype.h>
  33. #endif
  34. #endif
  35.  
  36. /* NNODES    number of nodes to allocate in each request */
  37. /* TDEPTH    trace stack depth */
  38. /* FORWARD    type of a forward declaration (usually "") */
  39. /* LOCAL    type of a local function (usually "static") */
  40.  
  41. /* for the Computer Innovations compiler */
  42. #ifdef CI
  43. #define NNODES        1000
  44. #define TDEPTH        500
  45. #endif
  46.  
  47. /* for the CPM68K compiler */
  48. #ifdef CPM68K
  49. #define NNODES        1000
  50. #define TDEPTH        500
  51. #define LOCAL
  52. #define AFMT        "%lx"
  53. #undef NULL
  54. #define NULL        (char *)0
  55. #endif
  56.  
  57. /* for the DeSmet compiler */
  58. #ifdef DESMET
  59. #define NNODES        1000
  60. #define TDEPTH        500
  61. #define LOCAL
  62. #define getc(fp)    getcx(fp)
  63. #define putc(ch,fp)    putcx(ch,fp)
  64. #define EOF        -1
  65. #endif
  66.  
  67. /* for the MegaMax compiler */
  68. #ifdef MEGAMAX
  69. #define NNODES        200
  70. #define TDEPTH        100
  71. #define LOCAL
  72. #define AFMT        "%lx"
  73. #define TSTKSIZE    (4 * TDEPTH)
  74. #endif
  75.  
  76. /* for the VAX-11 C compiler */
  77. #ifdef vms
  78. #define NNODES        2000
  79. #define TDEPTH        1000
  80. #endif
  81.  
  82. /* for the DECUS C compiler */
  83. #ifdef decus
  84. #define NNODES        200
  85. #define TDEPTH        100
  86. #define FORWARD        extern
  87. #endif
  88.  
  89. /* for unix compilers */
  90. #ifdef unix
  91. #define NNODES        200
  92. #define TDEPTH        100
  93. #endif
  94.  
  95. /* for the AZTEC C compiler */
  96. #ifdef AZTEC
  97. #define NNODES        200
  98. #define TDEPTH        100
  99. #define getc(fp)    agetc(fp)
  100. #define putc(ch,fp)    aputc(ch,fp)
  101. #endif
  102.  
  103. /* default important definitions */
  104. #ifndef NNODES
  105. #define NNODES        200
  106. #endif
  107. #ifndef TDEPTH
  108. #define TDEPTH        100
  109. #endif
  110. #ifndef FORWARD
  111. #define FORWARD
  112. #endif
  113. #ifndef LOCAL
  114. #define LOCAL        static
  115. #endif
  116. #ifndef AFMT
  117. #define AFMT        "%x"
  118. #endif
  119. #ifndef TSTKSIZE
  120. #define TSTKSIZE    (sizeof(NODE *) * TDEPTH)
  121. #endif
  122.  
  123. /* useful definitions */
  124. #define TRUE    1
  125. #define FALSE    0
  126. #define NIL    (NODE *)0
  127.  
  128. /* program limits */
  129. #define STRMAX        100        /* maximum length of a string constant */
  130.     
  131. /* node types */
  132. #define FREE    0
  133. #define SUBR    1
  134. #define FSUBR    2
  135. #define LIST    3
  136. #define SYM    4
  137. #define INT    5
  138. #define STR    6
  139. #define OBJ    7
  140. #define FPTR    8
  141.  
  142. /* node flags */
  143. #define MARK    1
  144. #define LEFT    2
  145.  
  146. /* string types */
  147. #define DYNAMIC    0
  148. #define STATIC    1
  149.  
  150. /* new node access macros */
  151. #define ntype(x)    ((x)->n_type)
  152. #define atom(x)        ((x) == NIL || (x)->n_type != LIST)
  153. #define null(x)        ((x) == NIL)
  154. #define listp(x)    ((x) == NIL || (x)->n_type == LIST)
  155. #define consp(x)    ((x) && (x)->n_type == LIST)
  156. #define subrp(x)    ((x) && (x)->n_type == SUBR)
  157. #define fsubrp(x)    ((x) && (x)->n_type == FSUBR)
  158. #define stringp(x)    ((x) && (x)->n_type == STR)
  159. #define symbolp(x)    ((x) && (x)->n_type == SYM)
  160. #define filep(x)    ((x) && (x)->n_type == FPTR)
  161. #define objectp(x)    ((x) && (x)->n_type == OBJ)
  162. #define fixp(x)        ((x) && (x)->n_type == INT)
  163. #define car(x)        ((x)->n_car)
  164. #define cdr(x)        ((x)->n_cdr)
  165. #define rplaca(x,y)    ((x)->n_car = (y))
  166. #define rplacd(x,y)    ((x)->n_cdr = (y))
  167.  
  168. /* symbol node */
  169. #define n_symplist    n_info.n_xsym.xsy_plist
  170. #define n_symvalue    n_info.n_xsym.xsy_value
  171.  
  172. /* subr/fsubr node */
  173. #define n_subr        n_info.n_xsubr.xsu_subr
  174.  
  175. /* list node */
  176. #define n_car        n_info.n_xlist.xl_car
  177. #define n_cdr        n_info.n_xlist.xl_cdr
  178. #define n_ptr        n_info.n_xlist.xl_car
  179.  
  180. /* integer node */
  181. #define n_int        n_info.n_xint.xi_int
  182.  
  183. /* string node */
  184. #define n_str        n_info.n_xstr.xst_str
  185. #define n_strtype    n_info.n_xstr.xst_type
  186.  
  187. /* object node */
  188. #define n_obclass    n_info.n_xobj.xo_obclass
  189. #define n_obdata    n_info.n_xobj.xo_obdata
  190.  
  191. /* file pointer node */
  192. #define n_fp        n_info.n_xfptr.xf_fp
  193. #define n_savech    n_info.n_xfptr.xf_savech
  194.  
  195. /* node structure */
  196. typedef struct node {
  197.     char n_type;        /* type of node */
  198.     char n_flags;        /* flag bits */
  199.     union {            /* value */
  200.     struct xsym {        /* symbol node */
  201.         struct node *xsy_plist;    /* symbol plist - (name . plist) */
  202.         struct node *xsy_value;    /* the current value */
  203.     } n_xsym;
  204.     struct xsubr {        /* subr/fsubr node */
  205.         struct node *(*xsu_subr)();    /* pointer to an internal routine */
  206.     } n_xsubr;
  207.     struct xlist {        /* list node (cons) */
  208.         struct node *xl_car;    /* the car pointer */
  209.         struct node *xl_cdr;    /* the cdr pointer */
  210.     } n_xlist;
  211.     struct xint {        /* integer node */
  212.         int xi_int;            /* integer value */
  213.     } n_xint;
  214.     struct xstr {        /* string node */
  215.         int xst_type;        /* string type */
  216.         char *xst_str;        /* string pointer */
  217.     } n_xstr;
  218.     struct xobj {        /* object node */
  219.         struct node *xo_obclass;    /* class of object */
  220.         struct node *xo_obdata;    /* instance data */
  221.     } n_xobj;
  222.     struct xfptr {        /* file pointer node */
  223.         FILE *xf_fp;        /* the file pointer */
  224.         int xf_savech;        /* lookahead character for input files */
  225.     } n_xfptr;
  226.     } n_info;
  227. } NODE;
  228.  
  229. /* execution context flags */
  230. #define CF_GO        1
  231. #define CF_RETURN    2
  232. #define CF_THROW    4
  233. #define CF_ERROR    8
  234.  
  235. /* execution context */
  236. typedef struct context {
  237.     int c_flags;            /* context type flags */
  238.     struct node *c_expr;        /* expression (type dependant) */
  239.     jmp_buf c_jmpbuf;            /* longjmp context */
  240.     struct context *c_xlcontext;    /* old value of xlcontext */
  241.     struct node *c_xlstack;        /* old value of xlstack */
  242.     struct node *c_xlenv,*c_xlnewenv;    /* old values of xlenv and xlnewenv */
  243.     int c_xltrace;            /* old value of xltrace */
  244. } CONTEXT;
  245.  
  246. /* function table entry structure */
  247. struct fdef {
  248.     char *f_name;            /* function name */
  249.     int f_type;                /* function type SUBR/FSUBR */
  250.     struct node *(*f_fcn)();        /* function code */
  251. };
  252.  
  253. /* memory segment structure definition */
  254. struct segment {
  255.     int sg_size;
  256.     struct segment *sg_next;
  257.     struct node sg_nodes[1];
  258. };
  259.  
  260. /* external procedure declarations */
  261. extern struct node *xleval();        /* evaluate an expression */
  262. extern struct node *xlapply();        /* apply a function to arguments */
  263. extern struct node *xlevlist();        /* evaluate a list of arguments */
  264. extern struct node *xlarg();        /* fetch an argument */
  265. extern struct node *xlevarg();        /* fetch and evaluate an argument */
  266. extern struct node *xlmatch();        /* fetch an typed argument */
  267. extern struct node *xlevmatch();    /* fetch and evaluate a typed arg */
  268. extern struct node *xlsend();        /* send a message to an object */
  269. extern struct node *xlenter();        /* enter a symbol */
  270. extern struct node *xlsenter();        /* enter a symbol with a static pname */
  271. extern struct node *xlintern();        /* intern a symbol */
  272. extern struct node *xlmakesym();    /* make an uninterned symbol */
  273. extern struct node *xlsave();        /* generate a stack frame */
  274. extern struct node *xlobsym();        /* find an object's class or instance
  275.                        variable */
  276. extern struct node *xlgetprop();    /* get the value of a property */
  277. extern char *xlsymname();        /* get the print name of a symbol */
  278.  
  279. extern struct node *newnode();        /* allocate a new node */
  280. extern char *stralloc();        /* allocate string space */
  281. extern char *strsave();            /* make a safe copy of a string */
  282.